home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / dboleedt.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  10KB  |  332 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       ActiveX Control Data Bindings Editor            }
  6. {                                                       }
  7. {       Copyright (c) 1995,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DbOleEdt;
  12.  
  13. interface
  14.  
  15. uses
  16.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.   StdCtrls, ExtCtrls, TypInfo, DsgnIntf, DbOleCtl, OcxReg, LibHelp;
  18.  
  19. type
  20.   TDataBindForm = class(TForm)
  21.     Panel1: TPanel;
  22.     OkBtn: TButton;
  23.     CancelBtn: TButton;
  24.     HelpBtn: TButton;
  25.     Label1: TLabel;
  26.     Label2: TLabel;
  27.     PropNameLB: TListBox;
  28.     FieldNameLB: TListBox;
  29.     BindBtn: TButton;
  30.     Label3: TLabel;
  31.     BoundLB: TListBox;
  32.     DeleteBtn: TButton;
  33.     ClearBtn: TButton;
  34.     procedure BindBtnClick(Sender: TObject);
  35.     procedure ClearBtnClick(Sender: TObject);
  36.     procedure DeleteBtnClick(Sender: TObject);
  37.     procedure FormDestroy(Sender: TObject);
  38.     procedure PropNameLBDblClick(Sender: TObject);
  39.     procedure FieldNameLBClick(Sender: TObject);
  40.     procedure HelpBtnClick(Sender: TObject);
  41.     procedure FormCreate(Sender: TObject);
  42.   private
  43.     FDbCtl: TDbOleControl;
  44.     procedure ClearBoundList;
  45.     procedure FillDialog;
  46.     procedure EnableButtons;
  47.   public
  48.     function DoEditControl(DbCtl: TDbOleControl): Boolean;
  49.   end;
  50.  
  51.   TDataBindEditor = class(TOleControlEditor)
  52.   private
  53.     FVerbID: Integer;
  54.   protected
  55.     procedure DoVerb(Verb: Integer); override;
  56.   public
  57.     function GetVerbCount: Integer; override;
  58.   end;
  59.  
  60.   TDataBindProperty = class(TClassProperty)
  61.   public
  62.     procedure Edit; override;
  63.     function GetAttributes: TPropertyAttributes; override;
  64.   end;
  65.  
  66. implementation
  67.  
  68. {$R *.DFM}
  69.  
  70. uses ActiveX, ComObj, DbConsts;
  71.  
  72. type
  73.   PObjRec = ^TObjRec;
  74.   TObjRec = record
  75.     FieldName: string;
  76.     DispID: TDispID;
  77.   end;
  78.  
  79. { TDataBindProperty }
  80.  
  81. procedure TDataBindProperty.Edit;
  82. var
  83.   DataBindForm: TDataBindForm;
  84. begin
  85.   DataBindForm := TDataBindForm.Create(Application);
  86.   try
  87.     if DataBindForm.DoEditControl(GetComponent(0) as TDbOleControl) then
  88.       Modified;
  89.   finally
  90.     DataBindForm.Free;
  91.   end;
  92. end;
  93.  
  94. function TDataBindProperty.GetAttributes: TPropertyAttributes;
  95. begin
  96.   Result := [paDialog, paReadOnly];
  97. end;
  98.  
  99. { TDataBindEditor }
  100.  
  101. procedure TDataBindEditor.DoVerb(Verb: Integer);
  102. var
  103.   DataBindForm: TDataBindForm;
  104. begin
  105.   if Verb = FVerbID then
  106.   begin
  107.     DataBindForm:= TDataBindForm.Create(nil);
  108.     try
  109.       DataBindForm.DoEditControl(Component as TDbOleControl);
  110.     finally
  111.       DataBindForm.Free;
  112.     end;
  113.   end
  114.   else
  115.     inherited DoVerb(Verb);
  116. end;
  117.  
  118. function TDataBindEditor.GetVerbCount: Integer;
  119. var
  120.   I, MaxVerb: Integer;
  121. begin
  122.   Result := inherited GetVerbCount + 1;
  123.   MaxVerb := 0;
  124.   // Need to find an unused Verb ID to use for the component editor.
  125.   // We just add 1 to the highest Verb ID found.
  126.   for I := 0 to Verbs.Count - 1 do
  127.     if Integer(Verbs.Objects[I]) >= MaxVerb then
  128.       MaxVerb := Integer(Verbs.Objects[I]);
  129.   FVerbID := MaxVerb + 1;
  130.   Verbs.AddObject(SDataBindings, TObject(FVerbID));
  131. end;
  132.  
  133. { TDataBindForm }
  134.  
  135. procedure TDataBindForm.BindBtnClick(Sender: TObject);
  136. var
  137.  ListObjRec: PObjRec;
  138. begin
  139.   if (PropNameLB.ItemIndex >= 0) and (PropNameLB.ItemIndex >= 0) then
  140.   begin
  141.     New(ListObjRec);
  142.     with ListObjRec^ do
  143.     begin
  144.       FieldName := FieldNameLB.Items[FieldNameLB.ItemIndex];
  145.       DispID := Integer(PropNameLB.Items.Objects[PropNameLB.ItemIndex]);
  146.     end;
  147.     BoundLB.Items.AddObject(PropNameLB.Items[PropNameLB.ItemIndex] +
  148.       ' <---> ' + FieldNameLB.Items[FieldNameLB.ItemIndex], TObject(ListObjRec));
  149.   end;
  150.   EnableButtons;
  151. end;
  152.  
  153. procedure TDataBindForm.ClearBoundList;
  154. var
  155.   I: Integer;
  156. begin
  157.   if BoundLB.Items.Count <> 0 then
  158.   begin
  159.     for I := 0 to BoundLB.Items.Count - 1 do
  160.       if PObjRec(BoundLB.Items.Objects[I]) <> nil then
  161.         Dispose(PObjRec(BoundLB.Items.Objects[I]));
  162.     BoundLB.Clear;
  163.   end;
  164.   EnableButtons;
  165. end;
  166.  
  167. procedure TDataBindForm.ClearBtnClick(Sender: TObject);
  168. begin
  169.   ClearBoundList;
  170. end;
  171.  
  172. procedure TDataBindForm.DeleteBtnClick(Sender: TObject);
  173. begin
  174.   if BoundLB.ItemIndex <> -1 then
  175.   begin
  176.     Dispose(PObjRec(BoundLB.Items.Objects[BoundLB.ItemIndex]));
  177.     BoundLB.Items.Delete(BoundLB.ItemIndex);
  178.   end;
  179. end;
  180.  
  181. function TDataBindForm.DoEditControl(DbCtl: TDbOleControl): Boolean;
  182. var
  183.   I: Integer;
  184. begin
  185.   FDbCtl := DbCtl;
  186.   FillDialog;
  187.   Result := ShowModal = mrOk;
  188.   if Result then
  189.   begin
  190.     FDbCtl.DataBindings.Clear;
  191.     for I:= 0 to BoundLB.Items.Count -1 do
  192.     begin
  193.       FDbCtl.DataBindings.Add;
  194.       FDbCtl.DataBindings.Items[I].DataField := PObjRec(BoundLB.Items.Objects[I]).FieldName;
  195.       FDbCtl.DataBindings.Items[I].DispID := PObjRec(BoundLB.Items.Objects[I]).DispID;
  196.     end;
  197.   end;
  198. end;
  199.  
  200. procedure TDataBindForm.EnableButtons;
  201.  
  202.   function CanBindProperty(DispID: TDispID): Boolean;
  203.   var
  204.     I: Integer;
  205.   begin
  206.     Result := True;
  207.     for I := 0 to BoundLB.Items.Count - 1 do
  208.       if PObjRec(BoundLB.Items.Objects[I])^.DispID = DispID then
  209.       begin
  210.         Result := False;
  211.         Exit;
  212.       end;
  213.   end;
  214.  
  215. begin
  216.   BindBtn.Enabled := (PropNameLB.ItemIndex >= 0) and
  217.     (FieldNameLB.ItemIndex >= 0) and (PropNameLB.Items.Count > 0) and
  218.     (FieldNameLB.Items.Count > 0) and
  219.     CanBindProperty(TDispID(PropNameLB.Items.Objects[PropNameLB.ItemIndex]));
  220.   DeleteBtn.Enabled := BoundLB.Items.Count > 0;
  221.   ClearBtn.Enabled := BoundLB.Items.Count > 0;
  222. end;
  223.  
  224. procedure TDataBindForm.FillDialog;
  225. const
  226.   PropDisplayStr = '%s (%d)';
  227.   BoundDisplayStr = '%s <---> %s';
  228. var
  229.   TypeAttr: PTypeAttr;
  230.   I, I2: Integer;
  231.   FuncDesc: PFuncDesc;
  232.   VarDesc: PVarDesc;
  233.   PropName, DocString: WideString;
  234.   HelpContext: Longint;
  235.   ListObjRec: PObjRec;
  236.   TI: ITypeInfo;
  237.   InsertStr: string;
  238. begin
  239.   if ((IUnknown(FDbCtl.OleObject) as IDispatch).GetTypeInfo(0,0,TI) = S_OK) then
  240.   begin
  241.     TI.GetTypeAttr(TypeAttr);
  242.     try
  243.       for I := 0 to TypeAttr.cFuncs - 1 do
  244.       begin
  245.         OleCheck(TI.GetFuncDesc(I, FuncDesc));
  246.         try
  247.           // Only show properties which are bindable and marked as either
  248.           // display bindable or default bindable. 
  249.           if (FuncDesc.invkind <> INVOKE_FUNC) and
  250.             (FuncDesc.wFuncFlags and FUNCFLAG_FBINDABLE <> 0)  and
  251.             ((FuncDesc.wFuncFlags and FUNCFLAG_FDISPLAYBIND <> 0) or
  252.             (FuncDesc.wFuncFlags and FUNCFLAG_FDEFAULTBIND <> 0)) then
  253.           begin
  254.             TI.GetDocumentation(FuncDesc.memid, @PropName, @DocString, @HelpContext, nil);
  255.             InsertStr := Format(PropDisplayStr, [PropName, FuncDesc.memid]);
  256.             if PropNameLB.Items.Indexof(InsertStr) = -1 then
  257.               PropNameLB.Items.AddObject(InsertStr, TObject(FuncDesc.memid));
  258.           end;
  259.         finally
  260.           TI.ReleaseFuncDesc(FuncDesc);
  261.         end;
  262.       end;
  263.       for I2 := 0 to TypeAttr.cVars - 1 do
  264.       begin
  265.         OleCheck(TI.GetVarDesc(I2, VarDesc));
  266.         try
  267.           // Only show properties which are bindable and marked as either
  268.           // display bindable or default bindable.
  269.           if (VarDesc.wVarFlags and VARFLAG_FBINDABLE <> 0) and
  270.             ((VarDesc.wVarFlags and VARFLAG_FDISPLAYBIND <> 0) or
  271.             (VarDesc.wVarFlags and VARFLAG_FDEFAULTBIND <> 0)) then
  272.           begin
  273.             TI.GetDocumentation(VarDesc.memid, @PropName, @DocString, @HelpContext, nil);
  274.             InsertStr := Format(PropDisplayStr, [PropName, FuncDesc.memid]);
  275.             if PropNameLB.Items.Indexof(InsertStr) = -1 then
  276.               PropNameLB.Items.AddObject(InsertStr, TObject(VarDesc.memid));
  277.           end;
  278.         finally
  279.           TI.ReleaseFuncDesc(FuncDesc);
  280.         end;
  281.       end;
  282.     finally
  283.       TI.ReleaseTypeAttr(TypeAttr);
  284.     end;
  285.     if (FDbCtl.DataSource <> nil) and (FDbCtl.DataSource.Dataset <> nil) then
  286.       FDbCtl.DataSource.DataSet.GetFieldNames(FieldNameLB.Items);
  287.     ClearBoundList;
  288.     if FDbCtl.DataBindings.Count > 0 then
  289.     begin
  290.       for I := 0 to FDbCtl.DataBindings.Count - 1 do
  291.       begin
  292.         New(ListObjRec);
  293.         ListObjRec^.FieldName := FDbCtl.DataBindings.Items[I].DataField;
  294.         ListObjRec^.DispID := FDbCtl.DataBindings.Items[I].DispID;
  295.         InsertStr := Format(BoundDisplayStr,
  296.           [PropNameLB.Items[PropNameLB.Items.IndexOfObject(TObject(FDbCtl.DataBindings.Items[I].DispID))],
  297.           (FDbCtl.DataBindings.Items[I].DataField)]);
  298.         BoundLB.Items.AddObject(InsertStr, TObject(ListObjRec));
  299.       end;
  300.     end;
  301.   end;
  302.   EnableButtons;
  303. end;
  304.  
  305. procedure TDataBindForm.FormDestroy(Sender: TObject);
  306. begin
  307.   ClearBoundList;
  308. end;
  309.  
  310. procedure TDataBindForm.PropNameLBDblClick(Sender: TObject);
  311. begin
  312.   // Enable double click to do the same thing as the bind button
  313.   if BindBtn.Enabled then BindBtnClick(nil);
  314. end;
  315.  
  316. procedure TDataBindForm.FieldNameLBClick(Sender: TObject);
  317. begin
  318.   EnableButtons;
  319. end;
  320.  
  321. procedure TDataBindForm.HelpBtnClick(Sender: TObject);
  322. begin
  323.   Application.HelpContext(HelpContext);
  324. end;
  325.  
  326. procedure TDataBindForm.FormCreate(Sender: TObject);
  327. begin
  328.   HelpContext := hcDAXDataBindings;
  329. end;
  330.  
  331. end.
  332.